# this module create socket and io watchers for tcp connection
# connect() - create and initialize watchers for connect type socket;
# bind() - create and initialize watchers for bind type socket;

# error codes:
### 1,2 - reserved. (timeout and tcp errors). 
# 3 - dns error. can't resolve name and etc. (see EV::ADNS)
# 4- can't create socket
# 5 - reserved fo future use
package Net::Coro::EV::Connect::Socket;
use common::sense;
use Net::Coro::EV::Connect::Resolve::EVADNS;
our $VERSION = 0.01;

use EV;

use Socket;
use Fcntl;
use bytes;

our $BINDIP = 0;
our $TIMEOUT = 10; 
our $MAX_CNAME_REDIRECT = 10;

our $TRACE_READ = 0;
our $TRACE_WRITE = 0;
our $TRACE_RCNT = 0;
our $TRACE_WCNT = 0;
our $TRACE_EVENT = 0;


sub new {
	my ($class, $resolver) =@_;
	
	my $this ={};
	$this->{_DNS} = $resolver || Net::Coro::EV::Connect::Resolve::EVADNS->new;
	$this->{_TIMEOUT} = $TIMEOUT;
	$this->{_BINDIP} = $BINDIP;
	
	bless $this, $class;
	return $this;
}

sub type {'socket'}

# for debug only !
# show last connected adress
sub address {
	my ($this) = @_;
	return ($this->{_HOST}, $this->{_PORT});
}

sub child {
	my ($this) = @_;
	my $child = {};
	bless $child, ref $this;
		
	while (my ($key, $val) = each(%$this)) {
		$child->{$key} = $val;
	}
	#$child->{_SOCKET} = $this->{_SOCKET}->child;
	delete $child->{_CALLER};
	return $child;
}

sub connect {
	die(__PACKAGE__." connect: arguments count less then 3") if $#_ < 3;
	my ($this, $host, $port, $caller) = @_;
	$this->{_CALLER} = $caller;
	$this->{_HOST} = $host;
	$this->{_PORT} = $port;
	
	$this->{_DNS}->resolve($host, $port, $this);
}

sub onresolve {
	my ($this, $ip, $port, $ipv6) = @_;
	return $this->err($this->{_DNS}->errm, $this->{_DNS}->errc) if !$ip;
	
	my $nip	= (!$ipv6)?inet_aton($ip):inet_aton6($ip);
	if (!$nip) {
		$this->err("socket: inet_aton fail for $ip. check max socket count.", 4);
		return;
	}
	
	my $addr = pack_sockaddr_in($port, $nip);
	

	socket(my $sock, (!$ipv6)?PF_INET:PF_INET6 ,SOCK_STREAM,0) or 
		return $this->err("socket: can't create socket. check max socket count", 4);
	
	fcntl ($sock, F_SETFL, O_NONBLOCK) or die ("socket client: can't set nonblock socket: $!");
	binmode $sock;
	
	if ($this->{_BINDIP}) {
		my $loc_ip = inet_aton($this->{_BINDIP}) or die ("socket client: bad interface ($this->{_BINDIP}): $!");;
		my $loc_addr = pack_sockaddr_in(0, $loc_ip);
		CORE::bind($sock, $loc_addr) or die ("socket client: bind: $!");
	}
	CORE::connect ($sock, $addr);
	my $mysockaddr = getsockname($sock);
	my ($myport, $myaddr) = sockaddr_in($mysockaddr);
	
	my $wio = EV::io($sock, EV::NONE, \&iocb); # EV::WRITE | EV::READ
	my $wtm = EV::timer $this->{_TIMEOUT}, $this->{_TIMEOUT}, \&tmcb;
	$wtm->data([EV::now, $this->{_TIMEOUT}, $wio]);
	
	$this->callback($wio, $wtm, inet_ntoa($myaddr), $myport);
}

sub tmcb {
	my ($w, $revents) = @_;
	my ($last_activity, $timeout, $wio) = @{$w->data};
	my $this = $wio->data;
	print "TRACE[".time."] $this->{_ID} Socket: timer event\n" if $TRACE_EVENT;

	my $now = EV::now;
	$timeout = $last_activity + $timeout;

	if ($timeout < $now) {
		$this->err("network timeout (".ref($this).")", 1);
	} else {
		#  there was some activity
		# but maybe we have set new timeout for this action
		# so recheck it with actual timeout

		$timeout = $last_activity + $this->{_TIMEOUT};
		if ($timeout < $now) {
			$this->err("network timeout (".ref($this)." with $this->{_TIMEOUT})", 1);
		} else {
			# remember tiemout for currentc action
			$w->data->[1] = $this->{_TIMEOUT};
			# rearm timer
			$w->set ($timeout - $now, 1);
		}
	}
}

sub iocb {
	my ($w, $revents) = @_;
	my $this = $w->data;
	print "TRACE[".time."] $this->{_ID} Socket: io event\n" if $TRACE_EVENT;	
	$this->{_WTM}->data->[0] = EV::now;
	
	if ($revents & EV::ERROR) {
		$this->onbreak("get EV::ERROR event");
		return;
	}
	
	if ($revents == EV::WRITE) {
		my $request = $this->{__REQUEST_BUFFER} || $this->onwrite;
		if (!$request) {
			print "TRACE[".time."] $this->{_ID} Socket: had nothing to write\n" if $TRACE_WRITE || $TRACE_WCNT ;
			return;
		}
		print "TRACE[".time."] $this->{_ID} Socket: request - ($request)\n" if $TRACE_WRITE;
		
		my $ret = send($w->fh, $request, MSG_NOSIGNAL);
		print "TRACE[".time."] $this->{_ID} Socket: write $ret bytes of ".bytes::length($request)." \n" if $TRACE_WCNT;
		

		return $this->onbreak($!) if ! defined $ret; # if errors occures
		return $this->onclose if $ret == 0; # if connection was closed
		
		
		if ($ret < bytes::length($request)) {
			bytes::substr($request, 0, $ret, '');
			$this->{__REQUEST_BUFFER} = $request;
			$w->events (EV::WRITE);
		} else {
			delete $this->{__REQUEST_BUFFER};
			$this->onwritten($w);
		}
	}
	
	if ($revents == EV::READ) {
		my ($ret, $buf, $response);
		while ($ret = sysread($w->fh, $buf, 65536)) {
			$response .= $buf;
		}
		print "TRACE[".time."] $this->{_ID} Socket: read ". ((defined $response)?bytes::length($response):$ret). "bytes\n" if $TRACE_RCNT;
		print "TRACE[".time."] $this->{_ID} Socket: response - ($response)\n" if $TRACE_READ;

		
		if (! defined $response) {
			return $this->onbreak($!) if ! defined $ret; # if errors occures
			return $this->onclose if $ret == 0; # if connection was closed
		}
		
		$this->onread($response);
	}
}


sub inet_aton6($) {
   return Socket::inet_pton(AF_INET6, $_[0]) if defined &Socket::inet_pton;
   
   # Support old Socket modules
   # stolen from AnyEvent::Socket
   
   # quick test to avoid longer processing
   my $n = $_[0] =~ y/://;
   return undef if $n < 2 || $n > 8;

   
   my ($h, $t) = split /::/, $_[0], 2;

   unless (defined $t) {
      ($h, $t) = (undef, $h);
   }

   my @h = split /:/, $h;
   my @t = split /:/, $t;

   # check for ipv4 tail
   if (@t && $t[-1]=~ /\./) {
      return undef if $n > 6;

      my $ipn = inet_aton pop @t
         or return undef;

      push @t, map +(sprintf "%x", $_), unpack "nn", $ipn;
   }

   # no :: then we need to have exactly 8 components
   return undef unless @h + @t == 8 || $_[0] =~ /::/;

   # now check all parts for validity
   return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t;

   # now pad...
   push @h, 0 while @h + @t < 8;

   # and done
   pack "n*", map hex, @h, @t
}


########## COMMON ARCHITECTURAL METHODS AND EVENT HANDLERS ###########
# no needed:
#sub onwritten
#sub onclose
#sub onbreak

sub callback {
	my ($this, @resp) = @_;
	undef $this->{_ERRM};
	undef $this->{_ERRC};
	(delete $this->{_CALLER})->onconnect(@resp);
}

sub err {
	my ($this, $msg, $code) = @_;
	
	$this->{_ERRM} = $msg;
	$this->{_ERRC} = $code;
	$this->close;
	(delete $this->{_CALLER})->onconnect();
}

sub close {
}

sub stop {
	my ($this) = @_;
	$this->{_DNS}->stop();
	$this->close();
	delete $this->{_CALLER};
}


########### COMMON PROPIRTIES ######################
sub errc {$_[0]->{_ERRC}}
sub errm {$_[0]->{_ERRM}}

sub id {	
	my ($this, $id) = @_;
	if (defined $id) {
		$this->{_ID} = $id;
	}
	$this->{_ID};
}

sub timeout {
	my ($this, $val) = @_;	
	$this->{_TIMEOUT} = $val if defined $val;
	$this->{_TIMEOUT};
}

sub bindip {
	my ($this, $val) = @_;	
	$this->{_BINDIP} = $val if defined $val;
	$this->{_BINDIP};
}

1;